home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / DropBin 1.5 / DropBinAE.p < prev    next >
Text File  |  1997-03-07  |  11KB  |  361 lines
  1. Unit DropBinAE;
  2.  
  3. Interface
  4.  
  5. Uses
  6.     Toolbox, DropBinUtils;
  7.  
  8. Const
  9.     kErrStringID    = 100;
  10.     kCantRunErr        = 1;
  11.     kAEVTErr        = 2;
  12.  
  13. Function BinHexFile(vRef: integer; dirId: longint; name: str255): integer; external;
  14.  
  15. Procedure InitAEVTStuff;
  16. Function GotRequiredParams(var theAppleEvent: AppleEvent): OSErr;
  17. Function GetTargetFromSelf(var targetDesc: AEAddressDesc): OSErr;
  18. Procedure _SendDocsToSelf(aliasList: AEDescList);
  19. Procedure SendODOCToSelf(var theFileSpec: FSSpec);
  20. Procedure SendQuitToSelf;
  21. Function HandleOAPP(var theAppleEvent: AppleEvent; var reply: AppleEvent; 
  22.                     handlerRefcon: longint): OSErr;
  23. Function HandleQuit (var theAppleEvent: AppleEvent; var reply: AppleEvent; 
  24.                     handlerRefcon: longint): OSErr;
  25. Function _HandleDocs (var theAppleEvent: AppleEvent; var reply: AppleEvent; opening: Boolean): OSErr;
  26. Function HandleODOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
  27.                     handlerRefcon: longint): OSErr;
  28. Function HandlePDOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
  29.                     handlerRefcon: longint): OSErr;
  30. Procedure DoHighLevelEvent(event: EventRecord); 
  31.  
  32.  
  33. Implementation
  34. {$NR+}
  35.  
  36. Procedure InitAEVTStuff;
  37.  
  38. Var
  39.     aevtErr:    OSErr;
  40.  
  41.     begin
  42.     aevtErr := noErr;
  43.     aevtErr := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication,
  44.                      @HandleOAPP, 0, false);
  45.     if aevtErr = noErr then
  46.         aevtErr := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments,
  47.                     @HandleODOC, 0, false);
  48.     if aevtErr = noErr then
  49.         aevtErr := AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments,
  50.                     @HandlePDOC, 0, false);
  51.     if aevtErr = noErr then
  52.         aevtErr := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication,
  53.                     @HandleQuit, 0, false);
  54.     if aevtErr <> noErr then
  55.         ;        { report an error }
  56.     end;
  57.  
  58. Function GotRequiredParams(var theAppleEvent: AppleEvent): OSErr;
  59.  
  60. Var
  61.     typeCode:        DescType;
  62.     actualSize:        Size;
  63.     retErr, err:    OSErr;
  64.  
  65.     begin
  66.     err := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr,
  67.                     typeWildCard, typeCode, NIL, 0, actualSize);
  68.     if err = errAEDescNotFound then
  69.         retErr := noErr
  70.     else if err = noErr then
  71.         retErr := errAEEventNotHandled
  72.     else 
  73.         retErr := err;
  74.     GotRequiredParams := retErr;
  75.     end;
  76.  
  77. Function GetTargetFromSelf(var targetDesc: AEAddressDesc): OSErr;
  78.  
  79. Var
  80.     psn:    ProcessSerialNumber;
  81.  
  82.     begin
  83.     psn.highLongOfPSN := 0;
  84.     psn.lowLongOfPSN := kCurrentProcess;
  85.     GetTargetFromSelf := AECreateDesc(typeProcessSerialNumber, @psn, 
  86.         sizeof(ProcessSerialNumber), targetDesc);
  87.     end;
  88.  
  89. Procedure _SendDocsToSelf(aliasList: AEDescList);
  90.  
  91. Var
  92.     err:        OSErr;
  93.     theTarget:    AEAddressDesc;
  94.     openDocAE, 
  95.     replyAE:    AppleEvent;        
  96.  
  97.     begin
  98. {    First we create the target for the event.   We call another }
  99. {    utility routine for creating the target. }
  100.     err := GetTargetFromSelf(theTarget);
  101.     if err = noErr then
  102.         begin
  103.         { Next we create the Apple event that will later get sent. }
  104.         err := AECreateAppleEvent(kCoreEventClass, kAEOpenDocuments, theTarget, 
  105.             kAutoGenerateReturnID, kAnyTransactionID, openDocAE);
  106.         if err = noErr then
  107.             begin
  108.             { Now add the aliasDescList to the openDocAE }
  109.             err := AEPutParamDesc(openDocAE, keyDirectObject, aliasList);
  110.             if err = noErr then
  111.                 {    and finally send the event }    
  112.                 {    Since we are sending to ourselves, no need for reply. }
  113.                 err := AESend(openDocAE, replyAE, kAENoReply + kAECanInteract, 
  114.                     kAENormalPriority, 3600, NIL, NIL);
  115.                 {    NOTE: Since we are not requesting a reply, we do not need to }
  116.                 {    need to dispose of the replyAE.  It is there simply as a  }
  117.                 {    placeholder. }
  118.             {    Dispose of the aliasList descriptor }
  119.             {    We do this instead of the caller since it needs to be done }
  120.             {    before disposing the AEVT }
  121.             err := AEDisposeDesc(aliasList);
  122.             end;
  123.         {    and of course dispose of the openDoc AEVT itself }
  124.         err := AEDisposeDesc(openDocAE);
  125.         end;
  126.     end;
  127.  
  128. Procedure SendODOCToSelf(var theFileSpec: FSSpec);
  129.  
  130. Var
  131.     err:        OSErr;
  132.     aliasList:    AEDescList;
  133.     aliasDesc:    AEDesc;
  134.     aliasH:        AliasHandle;
  135.     
  136.     begin
  137.     { Create the descList to hold the list of files }
  138.     err := AECreateList(NIL, 0, false, aliasList);
  139.     if err = noErr then
  140.         begin
  141.         { First we setup the type of descriptor }
  142.         aliasDesc.descriptorType := typeAlias;
  143.         {    Now we add the file to descList by creating an alias and then }
  144.         {    adding it into the descList using AEPutDesc }
  145.         err := NewAlias(NIL, theFileSpec, aliasH);
  146.         aliasDesc.dataHandle := Handle(aliasH);
  147.         err := AEPutDesc(aliasList, 0, aliasDesc);
  148.         DisposeHandle(Handle(aliasH));
  149.         { Now call the real gut level routine to do the dirty work }
  150.         _SendDocsToSelf(aliasList);
  151.         { _SendDocsToSelf will dispose of aliasList for me }
  152.         end;
  153.     end;
  154.  
  155. Procedure SendQuitToSelf;
  156.  
  157. Var
  158.     err, foo:    OSErr;
  159.     theTarget:    AEDesc;
  160.     quitAE, 
  161.     replyAE:    AppleEvent;
  162.  
  163.     begin
  164.     {    First we create the target for the event.   We call another }
  165.     {    utility routine for creating the target. }
  166.     err := GetTargetFromSelf(theTarget);
  167.     if err = noErr then
  168.         begin
  169.         { Next we create the Apple event that will later get sent. }
  170.         err := AECreateAppleEvent(kCoreEventClass, kAEQuitApplication, theTarget, 
  171.             kAutoGenerateReturnID, kAnyTransactionID, quitAE);
  172.         if err = noErr then
  173.             begin
  174.             {    and finally send the event }
  175.             {    Since we are sending to ourselves, no need for reply. }
  176.             err := AESend(quitAE, replyAE, kAENoReply + kAECanInteract, kAENormalPriority, 
  177.                 kAEDefaultTimeout, NIL, NIL);
  178.             foo := AEDisposeDesc(quitAE);
  179.             {    NOTE: Since we are not requesting a reply, we do not need to }
  180.             {    need to dispose of the replyAE.  It is there simply as a  }
  181.             {    placeholder. }
  182.             end;
  183.         foo := AEDisposeDesc(theTarget);
  184.         end;
  185.     end;
  186.     
  187. {    This routine is the handler for the oapp (Open Application) event.
  188.     
  189.     It first checks the number of parameters to make sure we got them all 
  190.     (even though we don't want any) and then calls the OpenApp userProc in QSUserProcs.
  191.     Finally it checks to see if the caller wanted a reply & sends one, setting any error.
  192. }
  193. Function HandleOAPP(var theAppleEvent: AppleEvent; var reply: AppleEvent; 
  194.                     handlerRefcon: longint): OSErr;
  195.  
  196. Var
  197.     err:    OSErr;
  198.     data:    str255;
  199.  
  200.     begin
  201.     err := GotRequiredParams(theAppleEvent);
  202.     ErrorAlert(kErrStringID, kAEVTErr, err);
  203.     if dbWindow <> nil then
  204.         ShowWindow(dbWindow);
  205.     gOApped := true;
  206.     gState := true;
  207.     if reply.dataHandle <> NIL then
  208.         begin    
  209.         data := 'Opening';
  210.         err := AEPutParamPtr(reply, 'errs', 'TEXT', @data, 7);
  211.         ErrorAlert(kErrStringID, kAEVTErr, err);
  212.         end;
  213.     HandleOAPP := err;
  214.     if handlerRefcon <> 0 then;
  215.     end;
  216.  
  217. {    This routine is the handler for the quit (Quit Application) event.
  218.     
  219.     It first checks the number of parameters to make sure we got them all 
  220.     (even though we don't want any) and then calls the QuitApp userProc in QSUserProcs.
  221.     Finally it checks to see if the caller wanted a reply & sends one, setting any error.
  222. }
  223. Function HandleQuit (var theAppleEvent: AppleEvent; var reply: AppleEvent; 
  224.                     handlerRefcon: longint): OSErr;
  225.  
  226. Var
  227.     err:    OSErr;
  228.     data:    str255;
  229.     
  230.     begin
  231.     err := GotRequiredParams(theAppleEvent);
  232.     ErrorAlert(kErrStringID, kAEVTErr, err);
  233.     gDone := true;
  234.     if reply.dataHandle <> NIL then
  235.         begin
  236.         data := 'Quiting';
  237.         err := AEPutParamPtr(reply, 'errs', 'TEXT', @data, 7);
  238.         ErrorAlert(kErrStringID, kAEVTErr, err);
  239.         end;
  240.     HandleQuit := err;
  241.     if handlerRefcon <> 0 then;
  242.     end;
  243.  
  244. Procedure OpenDoc(var myFSS: FSSpec);
  245.  
  246. Var
  247.     fileName:    Str255;
  248.     oe:            integer;
  249.     
  250.     begin
  251.     fileName := myFSS.name + '.hqx';
  252.     oe := HCreate(myFSS.vRefNum, myFSS.parID, fileName, 'ttxt','TEXT');
  253.     if (oe = paramErr) & (length(fileName) > 31) then
  254.         begin
  255.         DisplayMsg('Resulting file name "' + fileName + '" is too long... DropBin will '+
  256.             'use "' + copy(fileName,1,27) + '.hqx" instead.');
  257.         fileName := copy(fileName,1,27) + '.hqx';
  258.         oe := HCreate(myFSS.vRefNum, myFSS.parID, fileName, 'ttxt','TEXT');
  259.         end;
  260.     if (oe <> noErr) and (oe <> dupFNErr) then
  261.         begin
  262.         AlertUser('Unable to create file "'+fileName+'"', oe);
  263.         exit(OpenDoc);
  264.         end;
  265.     oe := HOpen(myFSS.vRefNum, myFSS.parID, fileName, fsRdWrPerm, gRefNum);
  266.     if oe <> noErr then
  267.         begin
  268.         AlertUser('Unable to open "'+fileName+'"', oe);
  269.         exit(OpenDoc);
  270.         end;
  271.     oe := SetEOF(gRefNum,0);    
  272.     if oe <> noErr then
  273.         begin
  274.         AlertUser('Unable to set EOF for "'+fileName+'"', oe);
  275.         exit(OpenDoc);
  276.         end;
  277.     if oe = noErr then
  278.         begin
  279.         gOutputName := fileName;
  280.         oe := BinHexFile(myFSS.vRefNum, myFSS.parID, myFSS.name);
  281.         oe := FSClose(gRefNum);
  282.         oe := FlushVol(nil,myFSS.vRefNum);
  283.         end;
  284.     end;
  285.  
  286. Function _HandleDocs (var theAppleEvent: AppleEvent; var reply: AppleEvent; opening: Boolean): OSErr;
  287.  
  288. Var
  289.     err:            OSErr;
  290.     myFSS:            FSSpec;
  291.     docList:        AEDescList;
  292.     index, 
  293.     itemsInList:    longint;
  294.     actualSize:        Size;
  295.     keywd:            AEKeyword;
  296.     typeCode:        DescType;
  297.     
  298.     begin
  299.     err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, docList);
  300.     ErrorAlert(kErrStringID, kAEVTErr, err);
  301.     err := GotRequiredParams(theAppleEvent);
  302.     ErrorAlert(kErrStringID, kAEVTErr, err);
  303.     if opening then    
  304.         begin
  305.         {    How many items do we have? }
  306.         err := AECountItems(docList, itemsInList);
  307.         ErrorAlert(kErrStringID, kAEVTErr, err);
  308.         for index := 1 to itemsInList do
  309.             begin
  310.             err := AEGetNthPtr(docList, index, typeFSS, keywd, typeCode,
  311.                     @myFSS, sizeof(myFSS), actualSize);
  312.             ErrorAlert(kErrStringID, kAEVTErr, err);
  313.             OpenDoc(myFSS);    
  314.             end;
  315.         if opening & (not gOApped) then
  316.             gDone := true;
  317.         end
  318.     else
  319.         err := errAEEventNotHandled;    { tells AEM that we didn't handle it!  }
  320.     ErrorAlert(kErrStringID, kAEVTErr, AEDisposeDesc(docList));
  321.     _HandleDocs := err;
  322.     if reply.dataHandle <> NIL then;
  323.     end;
  324.     
  325. {    This routine is the handler for the odoc (Open Document) event.
  326.     
  327.     The odoc event simply calls the common _HandleDocs routines, which will
  328.     do the dirty work of parsing the AEVT & calling the userProcs.
  329. }
  330. Function HandleODOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
  331.                     handlerRefcon: longint): OSErr;
  332.  
  333.     begin    
  334.     gState := true;
  335.     HandleODOC := _HandleDocs(theAppleEvent, reply, true);    { call the low level routine }
  336.     if handlerRefcon <> 0 then;
  337.     end;
  338.  
  339. {    This routine is the handler for the pdoc (Print Document) event.
  340.     
  341.     The pdoc event like the odoc simply calls the common _HandleDocs routines
  342. }
  343. Function HandlePDOC(var theAppleEvent: AppleEvent; var reply: AppleEvent;
  344.                     handlerRefcon: longint): OSErr;
  345.  
  346.     begin    
  347.     HandlePDOC := _HandleDocs(theAppleEvent, reply, false);    { call the low level routine }
  348.     if handlerRefcon <> 0 then;
  349.     end;
  350.  
  351. {    This is the routine called by the main event loop, when a high level
  352.     event is found.  Since we only deal with Apple events, and not other
  353.     high level events, we just pass everything onto the AEM via AEProcessAppleEvent
  354. }
  355. Procedure DoHighLevelEvent(event: EventRecord); 
  356.  
  357.     begin
  358.     ErrorAlert(kErrStringID, kAEVTErr, AEProcessAppleEvent(event));
  359.     end;
  360.  
  361. End.